home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / BORUSR2.ZIP;1 / BORENTR.PRG < prev    next >
Encoding:
Text File  |  1992-06-26  |  8.2 KB  |  292 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program.....: BORENTR.PRG
  3. *-- Programmer..: Ken Mayer
  4. *-- Date........: 06/12/1992
  5. *-- Notes.......: Used to enter data to ATUSER.DBF, created by Tony Lima,
  6. *--                uses basic layout from his ATUSERS.FMT file ...
  7. *-- Written for.: dBASE IV, 1.1/1.5
  8. *-- Rev. History: Tony created the input screen, I copied/modified for the
  9. *--               data entry program ...
  10. *-------------------------------------------------------------------------------
  11.  
  12. save screen to sEnter
  13. cEntColor = set("ATTRIBUTES")
  14. clear
  15. x=scrnhead("&cStand2","BOR-BBS Users Database - Data Entry")
  16. *-- 03/27/1992 -- use of NETWORK() function so that packs don't
  17. *--               cause problems ...
  18. if network()
  19.     use atusers excl
  20. else
  21.     use atusers
  22. endif
  23. *-- Added following line 12/30/91, Tony Lima
  24. use atusers order borbbs_id noupdate again in 2
  25.  
  26. *-- window for 'bio' field ...
  27. define window wBio from 9,10 to 20,79 double
  28.  
  29. lPgUp = .f.       && used if user presses <PgUp> in second screen ...
  30. lDone = .f.       && used if we have a blank record and end of first screen
  31.                   && occurs.
  32. lDone2 = .f.      && used with <Ctrl><end> to exit first screen and entering
  33.                   && of data
  34.  
  35. do while .t.          && Main Enter loop
  36.     
  37.     *-- Basically, if the user pressed <PgUp>, we're still working on the
  38.     *-- old record. Otherwise, if we're here, we want a new record ...
  39.     lDone2 = .f.   && set 'false' ...
  40.     if lPgUp 
  41.         lPgUp = .f.
  42.     else
  43.         append blank
  44.     endif
  45.     
  46.     *------------------------------------------------------------------
  47.     *-- SCREEN 1
  48.     *------------------------------------------------------------------
  49.     do while .t.      && first screen
  50.         
  51.         @5,0 clear
  52.         
  53.         @ 6,8 SAY "BORBBS ID:" 
  54.        * Following line modified by Tony Lima, 12/30/91, to set to
  55.        *  all capital letters and to add VALID with UDF
  56.       @ 6,19 GET Borbbs_id PICTURE "@!" valid NoDupe() ;
  57.           error chr(7)+"BORBBS ID already in dbf.  Use Edit instead."
  58.         @ 7,13 SAY "Name:"
  59.         @ 7,19 GET First_name picture "!XXXXXXXXXXXXXXXXXXXXXXXX";
  60.             message "First Name"
  61.         @ 7,45 GET Mi PICTURE "!" message "Middle Initial"
  62.         @ 7,47 GET Last_name picture  "!XXXXXXXXXXXXXXXXXXXXXXXX";
  63.             message "Last Name"
  64.         @ 8,8 SAY "Honorific:" 
  65.         @ 8,19 GET Honorific PICTURE "!XXXXX";
  66.             message "Honorific (Mr., Mrs., Ms., Dr., etc.)"
  67.         @ 8,26 say "Bio: "
  68.         @ 8,31 get bio window wBio;
  69.             message ;
  70.             "Interests of user -- press <Ctrl><Home> to enter, <Ctrl><End> when done"
  71.         @ 10,10 SAY "Company:" 
  72.         @ 10,19 GET Company message ""
  73.         @ 11,12 SAY "Title:" 
  74.         @ 11,19 GET Title message "Enter Job Title"
  75.         @ 12,10 SAY "Address:" 
  76.         @ 12,19 GET Baddress1 
  77.         @ 13,19 GET Baddress2 message "Enter if second address line necessary";
  78.             when .not. isblank(bAddress1)
  79.         @ 14,19 GET Bcity message "City"
  80.         @ 14,44 SAY "," 
  81.         @ 14,46 GET Bstate PICTURE "!!" valid required state(bState);
  82.             message "State" 
  83.         @ 14,50 GET Bzip PICTURE "#####-####" message "Zip"
  84.         @ 15,7 SAY "Work Phone:" 
  85.         @ 15,19 GET Bphone PICTURE "@R (999) 999-9999" 
  86.         *-- Fax number was moved to the Business/Job section as most people don't
  87.         *-- have a fax at home ...
  88.         @ 15,36 SAY "Fax:" 
  89.         @ 15,41 GET Fax PICTURE "@R (999) 999-9999" 
  90.         @ 17,13 SAY "Home:" 
  91.         @ 17,19 GET Haddress1 
  92.         @ 18,19 GET Haddress2 message "Enter if second address line necessary";
  93.             when .not. isblank(haddress1)
  94.         @ 19,19 GET Hcity message "City"
  95.         @ 19,44 SAY "," 
  96.         @ 19,46 GET Hstate PICTURE "!!" valid required state(hstate);
  97.             message "State"
  98.         @ 19,50 GET Hzip PICTURE "#####-####"  message "Zip"
  99.         @ 20,7 SAY "Home Phone:" 
  100.         @ 20,19 GET Hphone PICTURE "@R (999) 999-9999" 
  101.         @ 21, 8 SAY "BBS Phone:" 
  102.         @ 21,19 GET Bbsphone PICTURE "@R (999) 999-9999" 
  103.         do center with 23,80,;
  104.             "&cStand3","Press <PgDn> for next screen (or to skip this one)"
  105.         
  106.         read
  107.         
  108.         *-- save that keystroke ...
  109.         nI = readkey()
  110.         if nI > 255
  111.             nI = nI - 256
  112.         endif
  113.         
  114.         *-- remove message lines ...
  115.         @23,0 clear
  116.         
  117.         *-- is this a blank record? (Uses internal ISBLANK() if 1.5+, or
  118.         *-- function EMPTY() renamed to ISBLANK() in PROC.PRG file otherwise)
  119.         *-- OR did user press <Esc> key?
  120.         if ((IsBlank(borbbs_id) .and. IsBlank(last_name)) .or. lastkey() = 27);
  121.             .and. yesno2(.f.,"BC","This record is empty!","Is this ok?",;
  122.                     "(it will be deleted ...)","&cl_wind2")
  123.             lDone = .t.    && set this so we don't go into next screen
  124.             delete         && tag it for deletion
  125.             exit           && exit loop
  126.         endif
  127.         
  128.         *-- check for ^<End> ...
  129.         if nI+256 = 270  && ^<End> or ^W
  130.             @22,0 clear
  131.             cYN = "Y"
  132.             @23,25 say "Finished with this record? " get cYN picture "!";
  133.                 valid required cYN $ "YN";
  134.                 error chr(7)+"Enter 'Y' or 'N'"
  135.             read
  136.             
  137.             if cYN = "Y"
  138.                 lDone2 = .t.
  139.                 exit
  140.             else
  141.                 lDone2 = .f.
  142.                 exit
  143.             endif
  144.         
  145.         endif
  146.         
  147.         *-- check with user to ensure screen ok ...
  148.         @22,0 clear
  149.         cYN = "Y"
  150.         @23,25 say "Is this screen ok? " get cYN picture "!";
  151.             valid required cYN $ "YN";
  152.             error chr(7)+"Enter 'Y' or 'N'"
  153.         read
  154.         
  155.         *-- if it IS ok, exit screen 1
  156.         if cYN = "Y"
  157.             exit
  158.         endif
  159.         
  160.     enddo              && end of first screen
  161.     
  162.     *------------------------------------------------------------------
  163.     *-- SCREEN 2
  164.     *------------------------------------------------------------------
  165.     do while .t.      && second screen
  166.         
  167.         if lDone .or. lDone2 && blank record (or user pressed <Esc> in screen 1)
  168.                              && or <Ctrl><End>
  169.             exit
  170.         endif
  171.         
  172.         @5,0 clear
  173.         
  174.         @ 6,8 SAY "BORBBS ID:" 
  175.         @ 6,19 get Borbbs_id 
  176.         @ 7,13 SAY "Name:" 
  177.         @ 7,19 get First_name 
  178.         @ 7,45 GET Mi 
  179.         @ 7,47 GET Last_name 
  180.         clear gets  && these (above) are display only
  181.         
  182.         @ 9,7 SAY "CompuServe:" 
  183.         @ 9,19 GET Compuserve 
  184.         @ 10,9 SAY "MCI_Mail:" 
  185.         @ 10,19 GET Mci_mail 
  186.         @ 11,12 SAY "GEnie:" 
  187.         @ 11,19 GET Genie 
  188.         @ 12,13 SAY "FIDO:" 
  189.         @ 12,19 GET Fido 
  190.         @ 13,9 SAY "InterNet:" 
  191.         @ 13,19 GET Internet 
  192.         @ 14,11 SAY "Source:" 
  193.         @ 14,19 GET Source 
  194.         @ 15,10 SAY "Prodigy:" 
  195.         @ 15,19 GET Prodigy 
  196.         @ 16,11 SAY "Delphi:" 
  197.         @ 16,19 GET Delphi 
  198.         @ 17,3 SAY "America OnLine:" 
  199.         @ 17,19 GET Am_online 
  200.         
  201.         do center with 22,80,"&cStand3","Press <PgUp> for previous screen"
  202.         do center with 23,80,"&cStand3",;
  203.             "Press <PgDn> or <Ctrl><End> to complete/skip this screen"
  204.         read
  205.         
  206.         activate screen
  207.         @22,0 clear
  208.         
  209.         *-- set flag to go to previous screen
  210.         if lastkey() = 18  && <PgUp> key was pressed
  211.             lPgUp = .t.
  212.             exit
  213.         endif
  214.         
  215.         *-- ask user if screen is alright
  216.         @22,0 clear
  217.         cYN = "Y"
  218.         @23,25 say "Is this screen ok? " get cYN picture "!";
  219.             valid required cYN $ "YN";
  220.             error chr(7)+"Enter 'Y' or 'N'"
  221.         read
  222.         
  223.         *-- if it is, exit this screen ...
  224.         if cYN = "Y"
  225.             exit
  226.         endif
  227.     
  228.     enddo              && while .t. -- second screen
  229.     
  230.     if lPgUp       && user hit <PgUp> on second screen?
  231.         loop
  232.     endif
  233.     
  234.     if lDone       && if last record was blank, or <Esc> pressed, we done ...
  235.         exit
  236.     endif
  237.     
  238.     *-- check for more records ...
  239.     if yesno(.f.,"More?","Do you wish to add","another record?",;
  240.         "&cl_wind1")
  241.         loop
  242.     else
  243.         exit
  244.     endif
  245.     
  246. enddo  && end of main loop
  247.  
  248. *-- deal with blank records, if any ...
  249. delete for IsBlank(borbbs_id) .and. IsBlank(last_name)
  250. count to nDel for deleted()
  251. if nDel > 0
  252.     set cursor off
  253.     x=surround(12,24,"&cStand3","... One moment ... Cleaning up ...")
  254.     pack
  255.     set cursor on
  256. endif
  257.  
  258. *-- cleanup
  259. close database
  260. restore screen from sEnter
  261. release screen sEnter
  262. release window wBio
  263. do ReColor with cEntColor   && restore old colors
  264.  
  265. *--------------------------------------------------------------------------
  266. *-- back to menu ...
  267. *--------------------------------------------------------------------------
  268. RETURN
  269. *-- EoP: BORENTR.PRG
  270.  
  271. FUNCTION NoDupe   && added by TonyLima
  272.  
  273.     *-- work area 2
  274.     Select 2
  275.     *-- look for it
  276.     seek A->Borbbs_id
  277.     *-- if NOT found, we're fine ...
  278.     if .not. found()
  279.       select 1
  280.       lReturn = .T.
  281.     else
  282.       select 1
  283.       lReturn = .F.
  284.     endif
  285.     
  286. RETURN lReturn
  287. *-- EoF: NoDupe()
  288.  
  289. *-------------------------------------------------------------------------------
  290. *-- EoF: BORENTR.PRG
  291. *-------------------------------------------------------------------------------
  292.